home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / boot / loader.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.0 KB  |  81 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. signature Startup =
  3.  sig 
  4.      val core : System.Unsafe.object
  5.      val initial : System.Unsafe.object
  6.      val math : System.Unsafe.object
  7.      val name : string
  8.  end
  9.  
  10. functor Loader ( S : Startup ) : sig end =
  11.   struct
  12.  
  13.     open System
  14.     type object = System.Unsafe.object
  15.  
  16.     val applyCode : Code.code -> unit -> ((object list -> object) * string list)
  17.       = Code.apply
  18.  
  19.     val dict : (string*object) list ref = 
  20.       ref [("Initial",S.initial),("Core",S.core),("Math",S.math)]
  21.  
  22.     val _ = (System.Unsafe.pstruct := {core=S.core,math=S.math,initial=S.initial})
  23.  
  24.     exception Notfound_Loader
  25.  
  26.     fun lookup s = let
  27.       fun f ((s1,stru)::r) = if s=s1 then stru else f r
  28.         | f [] = raise Notfound_Loader
  29.       in
  30.         f (!dict)
  31.       end
  32.  
  33.     fun enter pair = (dict := pair::(!dict))
  34.  
  35.     fun readfile s = let
  36.           val stream = open_in s
  37.       val code = Code.inputCode(stream, (can_input stream))
  38.       in
  39.         close_in stream;
  40.         applyCode code
  41.     end
  42.  
  43.     fun getmo s = let
  44.       open System.Unsafe
  45.       fun f DATANIL = readfile s
  46.         | f (DATACONS(s',t,x)) = if s=s' then (cast t) else f x
  47.           in
  48.         f datalist
  49.       end
  50.  
  51.     val say = System.Print.say
  52.  
  53.     fun getstruct s = (lookup s)
  54.       handle Notfound_Loader =>
  55.         let val _ = (say "[Loading "; say s; say "]\n")
  56.         val g = getmo ("mo/" ^ s ^ ".mo");
  57.             val (exec,sl) = g ()
  58.             val structs = map getstruct sl
  59.             val _ = (say "[Executing "; say s; say "]\n")
  60.             val str = exec structs
  61.         in  enter (s,str);
  62.         str
  63.         end
  64.  
  65.     val _ = let open System.Unsafe.CleanUp in
  66.         (getstruct S.name; cleanup CleanForQuit)
  67.         (* this is the global exception handler of the sml system *)
  68.           handle Io s => (
  69.              say "uncaught Io exception (Loader): ";
  70.              say s;
  71.              say "\n";
  72.              cleanup CleanForQuit)
  73.            | exn => (
  74.              say "uncaught exception (Loader): ";
  75.              say (exn_name exn);
  76.              say "\n";
  77.              cleanup CleanForQuit)
  78.       end
  79.  
  80.   end (* functor Loader *)
  81.